perm filename SCR5B.F4[2,LCS] blob
sn#153746 filedate 1975-04-04 generic text, type T, neo UTF8
C CHECK P1, PP1, PX1, P1B **********
SUBROUTINE RUNIT
DIMENSION VY(30),VZ(30),PX1(25),IPT(25,31),NCNT(25,32)
1,P1(25),IV(2000),JPT(775)
C JPT = 25*31 (EQUIV. TO IPT)
COMMON/X/P(30),J,L,CNT(25),BT,MK,VX(35),PL(30),DF,DUR(26),TF,
1XT(25),ROFF(25),V(2000),NP(25),PCH(25,32),INST(26),IXIN,NINS,IALL,
1DURX,AMPFAC,IT(30),I,OP1,INUM(25),BG(80),INP(72),TP,
1CVTX,ISCA(12),IDAT(11),IQ(25),SCAL(86),MU5(14)
1,LIST(78),INVIS(25),RDEV(25),IBLA,KSLA,ICOM,ISEMI,IMIN,ISTAR
1,IEL,IPLUS
COMMON/SC/ML,JJ,NNUM,NFLG,JA,ISUB,CODE,IAMP,M
COMMON /Q/ BNW(40),NWZ
COMMON/RW/NWRITE,NDEC,LPT,DEBUG,KZY
EQUIVALENCE (IV,V),(VX2,VX(2)),(VX1,VX(1)),(X,LIST(1)),
1(Y,LIST(2)),(PL4,PL(4)),(VX3,VX(3)),
1(Z,LIST(3)),(NL,LIST(4)),(AC,LIST(5)),(ZPAR,LIST(6)),
1(VX4,VX(4)),(VX5,VX(5)),(VX6,VX(6)),(TBG,LIST(7)),(IDF,LIST(8))
1,(IF,ISCA(6)),(JPT,IPT),(PAR,LIST(9)),(T,LIST(10)),(K,LIST(11))
1,(PP1,P(1)),(P2,P(2)),(P3,P(3)),(VZ2,VZ(2)),(P4,P(4)),
1(IX,LIST(12)),(NW,LIST(14)),(NWX,LIST(15)),(TDUR,LIST(16))
1,(T2,LIST(17)),(T4,LIST(18)),(N,LIST(19)),(RD,LIST(20))
DATA IGEN/'GEN'/,IVAR/'VAR'/
2337 T=0
NWZZ=0
IAMP=0
IT3=0
PR=0
K=1
IX=0
BG(NINS+1)=19999.
4337 IF(V(I-1).EQ.-9900.-BY)I=I-1
V(I)=-19899.
PP1=0
T6=10000.
DO 2118 K=1,NINS
ROFF(K)=0
C********* FEB 17,71
M=NP(K)
IT(K)=0
IPT(K,31)=0
NCNT(K,31)=1
DO 2118 L=1,M
NCNT(K,L)=1
2118 IPT(K,L)=0
DO 5013 K=1,IXIN
5013 X=RAND(0.0,0.0)
ISLAC='FOR01'
REWIND 1
C****** FOR PDP10 ********
CALL OFILE(NDEC,ISLAC)
NW=1
NWX=0
TDUR=0
A=0
T2=1.
T4=1.
T5=0
J=1
MK=0
C IS THE ABOVE NEEDED?
IF(MX.NE.3)GO TO 40021
C THIS IS FOR PROOF READING - NOT ACTIVATED HERE!!!!
K=4
10023 N=AMOD(V(K),100.0)/-11.
IF((N.NE.2.AND.N.NE.3.AND.N.NE.4).OR
1 .V(K-2).LT.10000.)GO TO 10021
J=V(K+1)
IF(J.EQ.1)GO TO 10024
IF(N.EQ.3.AND.V(K+J+1).EQ.101.)J=J-1
N=V(K-2)
L=N/10000
M=N-L*10000
TYPE 10022,INST(L),M,J
10024 K=K+ABS(V(K-1))
10021 K=K+1
IF(K.LT.I)GO TO 10023
40021 IF(DEBUG.EQ.0)GO TO 1002
C PRINTS V ARRAY ON LPT FOR DEBUGGING.
N=1
40022 K=N+1
IF(N.GT.I)CALL EXIT
X=V(N)
IF(X.EQ.-199..OR.X.EQ.-99.)GO TO 40024
IF(X.GE.0)GO TO 40023
WRITE(LPT,4002)X
N=N+1
GO TO 40022
40024 J=N+1
GO TO 40025
C FOR 'SECTIONS'
40023 J=ABS(V(K))+K-1
40025 PRINT 4002,(V(K),K=N,J)
N=J+1
GO TO 40022
10022 FORMAT(1XA5,' P',I2,' HAS ',I3,' ITEMS.')
4002 FORMAT(10F12.3)
1002 IF(IDALL.LT.0)GO TO 600
X=DUR(IDALL)
DO 2002 K=1,NINS
2002 IF(DUR(K).LT.0)DUR(K)=X
C ***** SORTER *************************
C ******* OUTPUT LOOP FROM HERE ON ********
600 IL=0
C********** BELOW IS FOR 'SECTIONS'
KODE=0
NWX=NWX+1
MK=MK+1
Y=BNW(NW)
723 IL=IL+1
3723 Z=V(IL)
IF(Z.EQ.-19899.)GO TO 732
IF(Z.NE.-9900.-Y)GO TO 723
C********** BELOW IS FOR 'SECTIONS'
IF(V(IL-2).EQ.-199.)KODE=IV(IL-1)
2723 IL=IL+1
729 K=IL+2
MOT=V(IL+1)
RD=V(K)
IF(RD.EQ.-67.)GO TO 3726
RB=V(IL)
C************ DOWN TO 4150 IS FOR 'SECTIONS'
IF(RB.NE.-99.)GO TO 4150
KODE=IV(K-1)
2160 IF(KODE.EQ.0)GO TO 723
WRITE(LPT,9150)KODE
KL=Y/10000.
RB=Y+KL*10000.
DO 5150 KL=1,I
IF(V(KL).NE.-199..OR.IV(KL+1).NE.KODE)GO TO 5150
IV(K-1)=0
C WHEN 'PLAY' HAS BEEN FOUND, INDENTIFIER CHNGED TO 0
RD=V(KL+2)+9900.
JDO=KL+2
DO 6150 L=JDO,I
M=V(L)/(-9900.)
IF(M.NE.1)GO TO 6150
RA=RB+RD-V(L)-9900.
V(L)=-9900.-RA
C UPDATES BG TIMES INSIDE SECTION.
CALL BGSORT(RA)
C7150 IF(RA.EQ.BNW(KA))GO TO 6150
C UPDATES LIST OF CHANGE TIMES.
6150 IF(V(L).EQ.-299.)GO TO 160
5150 CONTINUE
160 IL=1
GO TO 3723
C*********** ABOVE IS FOR 'SECTION' REPEATS
4150 LK=RB/10000.+.2
IF(LK.GE.98)GO TO 7700
LP=RB-LK*10000
C LK=INST # LP=PARAM #
LN=IPT(LK,LP)
IPT(LK,LP)=IL+2
IF(RD.EQ.-66.)GO TO 726
IF(RD.EQ.-55..OR.RD.EQ.-56.)GO TO 1726
IF(RD.EQ.-23)GO TO 6700
2727 ML=IPT(LK,LP)
IF(MOT.GT.0)GO TO 3727
C USE NEG WDCNT FOR 'ALL'
M=LK+1
DO 4727 KL=M,NINS
IF(NP(KL).LT.LP.AND.LP.LT.31)NP(KL)=LP
IPT(KL,LP)=-(LK+(LP-1)*KZY)
NCNT(KL,LP)=10000
4727 IF(DUR(KL).LT.0)DUR(KL)=1000.
C ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
C AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
C ABOVE CHANGED TO BELOW DEC.6,72. 'ALL' WAS OMITTING 1ST ITEM.
GO TO 727
C 'MOVE' WITH 'ALL' KEEPS ORIGINAL TIME DATA REGARDLESS OF BG TIMES.
3727 IF(V(IL).NE.V(LN-1).OR.LN.EQ.0)GO TO 727
CC ************ JAN 20 ***********
DO 1727 L=1,NINS
DO 1727 KL=1,NP(L)
IF(LN.NE.IPT(L,KL))GO TO 1727
NCNT(L,KL)=10000
C ******* JAN 29,70
IPT(L,KL)=ML
C RESETS POINTERS FOR DUPL AND REP INSTS.
C *** 'ALL' WILL NOT WORK WITH RAN TF.!!!!!*******FEB 21,73
1727 CONTINUE
727 NCNT(LK,LP)=10000
C******** MAY 13,71 RHY REP. FEATURE OMITTED.
2150 IF(MOT.LT.0)MOT=-MOT
IL=IL+MOT+1
3150 IF(V(IL).LT.0)GO TO 3723
GO TO 729
726 RB=V(IL+3)
K=RB/10000.
L=RB-K*10000
IPT(LK,LP)=-(K+(L-1)*KZY)
GO TO 2727
3726 LK=V(IL)
M=V(K+1)
KL=NP(M)
DO 4726 L=1,KL
IPT(LK,L)=IPT(M,L)
IF(IPT(M,L).NE.0)NCNT(LK,L)=10000
C****** JUN 29 71 (LK,L) WAS (L,K)....???????
4726 CONTINUE
IPT(LK,31)=IPT(M,31)
K=0
GO TO 2150
C ABOVE IS FOR DUPLICATION ROUTINE NEXT ADJUSTS TIMES FOR 'RTAP'
6700 KL=IL+V(IL+1)+1.3
RC=V(K-2)
1770 IF(V(KL).LT.0)GO TO 700
2700 KL=KL+V(KL+1)+1.3
GO TO 1770
700 KL=KL+1
IF(Z.NE.V(KL-1).OR.V(KL).NE.RC)GO TO 2700
KL=KL+3
KN=IL+3
LN=V(KN)+.3
DO 3700 L=1,LN,2
RA=V(L+KN)
KA=V(L+KN+1)+.3
RB=0
DO 4700 LP=1,KA
4700 RB=RB+V(KL+LP)
DO 5700 LP=1,KA
5700 V(KL+LP)=V(KL+LP)/RB*RA
V(KL+KA)=V(KL+KA)+.00030
3700 KL=KL+KA
GO TO 2150
C BELOW FOR 'TEMPO' SETUP
7700 T2=V(IL+4)
T1=V(IL+3)
TBG=Y
TDUR=V(IL+2)
CALL SQYY(AC,T1,T2,TDUR)
8700 IF(TDUR.EQ.0)TDUR=10000.
T5=1.
T6=TBG+TDUR
IT3=1.
IF(LK.EQ.98)IT3=IL+2
T4=1.
GO TO 2150
C*************** ANY WDCNTS DOWN FROM HERE. *********
C NEXT ADJUSTS 'MOVE' TIMES IF BG IS AT A NOTE NUMBER.
1726 IF(V(IL-1).GT.-19000.)GO TO 2727
RA=BT
K=IL-1
2726 V(K)=-9900.-RA
L=K+5
RB=V(L)+V(L-1)
V(L-1)=RA
K=K+V(K+2)+2
IF(V(K).GT.-19000..OR.V(K+1).NE.V(IL).OR.
1 V(K).NE.-9900.-RB)GO TO 2727
RA=RA+V(L)
CALL BGSORT(RA)
GO TO 2726
C CONVERTS BG TIME OF NOTE NUM TO REAL TIME. DOESN'T WORK WITH -66!
C NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
732 DO 2606 K=NW,NWZ
2606 BNW(K)=BNW(K+1)
NWZ=NWZ-1
IF(NWZ.EQ.0)GO TO 2111
IF(NWZZ.EQ.1)GO TO 5111
NWZZ=1
IF(NWZ.EQ.1)GO TO 1111
DO 3111 K=1,NWZ
IF(BNW(K).LT.1000.)GO TO 3111
X=BNW(NWZZ)
BNW(NWZZ)=BNW(K)
BNW(K)=X
NWZZ=NWZZ+1
3111 CONTINUE
5111 IF(NWZZ.EQ.NWZ)GO TO 1111
L=NWZZ+1
X=BNW(NWZZ)
DO 4111 K=L,NWZ
IF(BNW(K).GT.X)GO TO 4111
RA=BNW(K)
BNW(K)=X
X=RA
4111 CONTINUE
BNW(NWZZ)=X
GO TO 1111
9150 FORMAT(/3X'******* SECTION ',A1)
2111 NWZ=-1
C ABOVE ORDERS BNW DATA TO SAVE TIME AT 10 ON PG2.
1111 K=NWX-1
IF(NWX.NE.1)GO TO 1486
2 PRINT 111,I,IXIN,CVTX,TF
111 FORMAT(//' ***** SCORE *****',10X,
1'V ARRAY=',I4,'/2000 RANDOM NUMBER =',I6,4X,'SRATE=',F6.0,
14X,'TEMPO FACTOR=',F6.2/)
1486 IF(NWX.GT.1.AND.IT(J).NE.-3)PRINT 3154,K,Y
IF(IT(J).EQ.-3)PRINT 5154,K,BX,INST(J)
DO 602 K=1,NINS
IF(DUR(K).LT.0)CALL EXIT
48 LK=INST(K)
C**********************
IF(NCNT(K,31).NE.10000.AND.NWX.GT.1)GO TO 8826
IJ=IPT(K,31)
NCNT(K,31)=1
X=0
IF(IJ.NE.0)X=V(IJ+2)
RA=DUR(K)
IF(RA.GT.10000.)GO TO 83
PRINT 5396,LK,INUM(K),X,RA
GO TO 8826
5396 FORMAT(6XA4,'= INST NUM',I3,12X,
1'RANDOM TF =',F4.2,9X,'DURATION =',F6.2,'"')
7396 FORMAT(6XA4,'= INST NUM',I3,12X,
1'RANDOM TF =',F4.2,9X,'DURATION =',F5.0,'NOTES')
4396 FORMAT(12X'% RANDOM RESTS DUR=',F7.3,'", FROM',F6.3,' TO',F6.3)
485 FORMAT(35X'% RANDOM RESTS = ',F4.2)
83 RA=RA-10000.
PRINT 7396,LK,INUM(K),X,RA
8826 CONTINUE
C ABOVE IS TEMPORARY********
602 CONTINUE
715 IF(IT3.NE.1.)GO TO 1602
RA=T1*TP
RB=T2*TP
WRITE(LPT,6154)RA,RB,TDUR
IT3=0
1602 IF(NWX.EQ.1)GO TO 315
IF(IT(J).EQ.-3)GO TO 1108
C*********** JUNE 1,71
6154 FORMAT(' TMP=',F7.3,' TO',F8.3,' DURING',F6.2,' SECS.'/)
5154 FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',F5.0,1XA5,' >>'/)
902 FORMAT(1XA5/)
3154 FORMAT(/' << BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
4154 FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)
C*********** JUNE 1,71
IT(J)=IT(J)/10
GO TO 1108
315 IF(OP1.NE.0)WRITE(LPT,4154)OP1
1601 IF(NWX.GT.1) GO TO 1108
IF(TF.GT.10.)TF=TF/60.
TF=1000./TF
9926 DO 5015 K=1,NINS
IQ(K)=BG(K)*10000.
BG(K)=0
INP(K)=0
PX1(K)=0
IF(DUR(K).LT.10000.)DUR(K)=DUR(K)-.0001
C******* FEB. 16,71 FOR ROUND-OFF NONSENSE
5015 CNT(K)=0
BW=0
CVTX=511./CVTX
GO TO 500
752 FORMAT(1X15A5)
1108 M=0
JC=0
IF(NWZ.LT.0)GO TO 1740
C NWZZ IS SET AT 3111 IN SORTR.
DO 740 K=1,NWZZ
X=BNW(K)
IF(X-.0001.GT.BT.OR.X.LE.BW.OR.BW.LT.0)GO TO 2740
IT(J)=IT(J)*10
NW=K
GO TO 600
2740 IF(X.LT.1000..OR.X-J*10000.NE.CNT(J)+1.)GO TO 740
X=BT+PR
NW=K
BX=CNT(J)+1.
IT(J)=-3
GO TO 600
740 CONTINUE
1740 IT(J)=0
31 KL=1
2031 CNT(J)=CNT(J)+1
ICT=CNT(J)
C INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
NPA=NP(J)
PP1=PX1(J)
IF(BT.GE.DUR(J))GO TO 5174
IF(IQ(J).EQ.0)GO TO 200
P2=-IQ(J)/10000.
IQ(J)=0
CNT(J)=-1
ICT=-1
GO TO 4203
C MK IS FLAG FOR RESTS
200 MK=0
IF((BT.EQ.0.AND.J.EQ.1).OR.IPT(J,1).EQ.0)GO TO 203
KN=IPT(J,1)-1
IF(KN.GT.0)GO TO 12033
12032 KN=JPT(-KN)
IF(KN.LT.0)GO TO 12032
KN=KN-1
C FOR 'ALL' IN P32. FOLLOWS UP ON POINTERS TO POINTERS!
C SOMEDAY PUT PX1(32) IN WITH OTHER PARAMS BELOW!!!!
12033 IJ=V(KN)
IF(IABS(IJ).EQ.4)GO TO 1203
C 'IABS' IS FOR -4 USED WITH 'ALL'(ABS(V(KN)) IN MUS10 VERSION.)
Z=(BT+9900.+V(KN-2))/V(KN+2)
C******* FEB 19,71
IF(Z.GT.1.)Z=1.
Y=V(KN+3)
X=(V(KN+4)-Y)*Z+Y
C******* FEB 19,71
GO TO 204
1203 X=V(KN+3)
204 Y=RAND(0.0,1.0)
IF(Y-X.LT.0)MK=-1
203 DF=1.
C DF=DUTY FACTOR
DO 2155 L=2,NPA
VX(L)=0
ISUB=0
C SUBR FLAG
IDF=0
C IDF IS DUTY FACTOR FLAG
IJ=IPT(J,L)
12031 IF(IJ.LT.0)IJ=JPT(-IJ)
IF(IJ)GO TO 12031
C FOLLOWS UP ON POINTERS TO POINTERS!
PM=1.
IF(IJ.GT.1)GO TO 2157
P(L)=0
GO TO 21551
C 7/73
2157 LN=IJ+2
NM=ABS(V(IJ-1))+LN-4
NL=V(IJ)
IF(NL.GT.-200)GO TO 372
ISUB=-1
NL=NL+200
C FOR SUBROUTINES
372 IF(NL.GT.-100)GO TO 272
IDF=-1
NL=NL+100
C DEC.6,72 FINDS DUTY FACTOR PARAM
272 VIJ2=V(IJ+1)
KN=NL/(-11)
IF(KN.EQ.0)GO TO 1100
GO TO (61,62,62,62,65,65,67,68),KN
1100 IF(VIJ2.EQ.1.)GO TO 1200
ML=3
1900 KA=1
VY(1)=0
DO 1156 K=LN,NM,ML
VY(KA+1)=V(K)+VY(KA)
1156 KA=KA+1
X=RAND(0.0,1.)
DO 1157 K=2,11
IF(X.GT.VY(K))GO TO 1157
KL=K-1
IF(KN.EQ.7)GO TO 6157
GO TO 1400
1157 CONTINUE
1400 LN=IJ+3*KL
1462 RA=V(LN)
IF(RA.EQ.10000.)GO TO 5174
C FOR "FINE" IN RLIST
RB=V(LN+1)
PAR=RAND(RA,RB)
1300 IF(NL.NE.-1)PM=2.
C IF 2 THEN PRINTS A5
GO TO 1155
1200 PAR=V(IJ+2)
GO TO 1300
C NEXT IS FOR SUBROUTINE AND QUAD CALLS
61 X=P2
CALL SUBR
IF(L.EQ.2)GO TO 4203
IF(X.EQ.P2)GO TO 21552
PP2=P2
PR=P2
GO TO 21552
C ABOVE IS FOR P2 CHANGES IN SUBROUTINE
C TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
C ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
C BE SET TO 'REAL TIME'.)
C FOLLOWING IS FOR STRINGS OF VALUES.
62 KL=NCNT(J,L)+1
IF(KL.GT.VIJ2)KL=1
IF(NL.NE.-46.AND.NL.NE.-36)GO TO 162
C THIS PART FOR STRINGS OF RAND SELECTION
LN=KL+IJ+1
KL=KL+1
IF(KL.GT.VIJ2)KL=1
NL=NL+45
C FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1. FOR NOTES, =9)
162 NCNT(J,L)=KL
IF(NL.GT.-22)GO TO 1462
C JUMP RAND SELECTION
PAR=V(IJ+KL+1)
C********** MAY 13,71 RHY REPEAT FEATURE OMITTED.
C************************
IF(KN.NE.3)GO TO 1155
C*******JULY 16,71 IF(PAR.EQ.101.)GO TO 5174
IF(PAR.EQ.10000.)GO TO 5174
PM=2.
IF(PAR.GT.100..OR.PAR.LT.1.)PM=3.
IF(PAR.EQ.85.)MK=-1
GO TO 5155
65 W=-9900.-V(IJ-3)
C W=BG TIME OF MOVE.
X=ABS(V(IJ-1))
IF(NL.EQ.-56.OR.NL.EQ.-58)PM=2.
Z=(BT-W)/VIJ2
C Z= % OF WAY THROUGH.
IF(Z.GT.1.)Z=1.
Y=V(LN)
W=V(IJ+3)
IF(X.EQ.8.)W=V(IJ+4)
C X=WD CNT. =8 IS FOR RAND. RANGES
IF(NL.LT.-58)GO TO 16002
PAR=(W-Y)*Z+Y
IF(X.EQ.8.)GO TO 1600
GO TO 1155
C************** JUNE 1,71
C FOR "MOVX"
16002 PAR=RMOVX(W,Y,Z)
C SEE FUNCTION RMOVX 6/74 -- CAN'T HAVE -20→+20, ETC., -20→-40 OK.
C THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
IF(X.NE.8.)GO TO 1155
W=V(IJ+5)
Y=V(IJ+3)
X=RMOVX(W,Y,Z)
GO TO 16003
C NEXT IS FOR MOVING RAND RANGES.
C1600 PAR=(V(IJ+4)-Y)*Z+Y
1600 W=V(IJ+3)
C*********** BACK TO 65 IS NEW. FEB. 15,71
X=(V(IJ+5)-W)*Z+W
C************ JUNE 1,71
16003 PAR=RAND(PAR,X)
GO TO 1155
67 LN=IJ+3
NM=LN+VIJ2-1
ML=1
GO TO 1900
4155 K=(PAR-9999.0)*100.+.1
P(L)=P(K)
IF(L.EQ.2.AND.K.EQ.2)P2=PX2
C PX2=LAST UNPROCESSED VALUE OF P2 (+ OR -) 7/74
PM=PL(K)
VX(L)=VX(K)
GO TO 21551
C ANY # OVER 9999. REPEATS ANOTHER PARAM.(9999.21 REPEATS P21)
6157 LN=V(LN-1)
DO 1068 K=1,KL
1068 IF(K.LT.KL)LN=LN+V(LN)+1
2068 PM=LN+1
PAR=LN+V(LN)
GO TO 5155
68 KL=NCNT(J,L)
IF(KL.EQ.0.OR.KL.EQ.10000)KL=VIJ2
PM=KL+1
PAR=PM+V(KL)-1
KL=PAR+1
IF(V(KL).EQ.10000.)DUR(J)=BT
C 'END' OR 'FINE' IN 'LIT' LIST.
IF(V(KL).EQ.999.)KL=IJ+2
NCNT(J,L)=KL
GO TO 5155
C ******* JAN 20 *************
1155 IF(PAR.EQ.10000.)GO TO 5174
C TYPE 'END' OR 'FINE' AS LAST IN ANY STRING TO SET DURATION.
IF(PAR.GT.9999..AND.PM.EQ.1.)GO TO 4155
C****JULY 16,71 1155 IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
5155 P(L)=PAR
ML=ABS(V(IJ-1))-2
VX(L)=V(ML+IJ)
21551 PL(L)=PM
IF(ISUB.LT.0)GO TO 61
IF(L.EQ.2)GO TO 4203
C**** WHAT ABOUT 'POINTERS TO POINTERS' AND IJ ?????
21552 IF(IDF.GE.0)GO TO 2155
DF=PAR
IDF=0
2155 CONTINUE
GO TO 1170
4203 PR=P2
PX2=P2
C TO SAVE THE UNPROCESSED P2 FOR 'P2 P2;' IN INPUT. 7/74
IF(T5.EQ.0)GO TO 7203
IF(IT3.LE.1.OR.BT.LT.TBG+TDUR)GO TO 6203
3155 IT3=IT3+3
TBG=TBG+TDUR
TDUR=V(IT3)
IF(BT.GE.TBG+TDUR)GO TO 3155
T1=V(IT3+1)
T2=V(IT3+2)
CALL SQYY(AC,T1,T2,TDUR)
6203 RA=PR
IF(BT.EQ.TBG)XT(J)=T1
K=IT3
RC=0
RD=1
KA=1
RB=0
Z=TDUR+TBG-BT
X=T1
Y=T2
YY=AC
CHN=TBG
ZZ=TDUR
4020 CALL ACCL(RA,KA,RC,XA,Z,Y,X,XT(J),YY,RB,W)
IF(RC.EQ.0)GO TO 8203
2011 CALL ACCL2(XA,RA,K,ZPAR,CHN,ZZ,KA,X,Y,Z,YY,PR)
GO TO 4020
8203 P2=RA*RD
7203 P2=P2*T4
X=P2*TF
C P2 IS KEPT WITHOUT TF*
K=X+.5
IF(X.LT.0)K=X-.5
72031 ROFF(J)=ROFF(J)+K-X
IF(ABS(ROFF(J)).LT.1.)GO TO 7155
Y=1.
IF(ROFF(J).LT.0)Y=-1.
K=K-Y
ROFF(J)=ROFF(J)-Y
C ROUND-OFF GAP WILL NOT EXCEED .001
C*********** FEB 17,71
7155 PP2=K/1000.
C AVOIDS ROUND-OFF PROBLEMS
IF(IPT(J,31).EQ.0)GO TO 6155
IF(ICT.LT.0)GO TO 1170
X=V(IPT(J,31)+2)/2.
Y=RAND(-X,X)
IF(PP2.GE.0)GO TO 615
MK=-1
PP2=-PP2
615 PP2=PP2-RDEV(J)+Y
RDEV(J)=Y
C TOTAL RAND DEV. WON'T EXCEED P31
C SET P31 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)
K=PP2*1000.+.5
C****** CHECK THIS OUT 1/10/72 :::::::
61551 PP2=K/1000.
C NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
6155 IF(ICT.LT.0)GO TO 1170
GO TO 2155
1170 IF(MK.LT.0.OR.PP2.LT.0)GO TO 2022
ZPAR=PP1
C WHY DO I USE P1B INSTEAD OF PP1 LATER ON???? 4/73
PX1(J)=PP1+PP2
C ZPAR IS USED HERE WHEN OPX1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
LK=INST(J)
IF(PP1.LT.OP1)GO TO 2612
IF(INVIS(J).NE.0)GO TO 2170
1204 IF(PL4.NE.1.)GO TO 2170
P4=P4*AMPFAC
L=0
INP(J)=P4
DO 1021 K=1,NINS
1021 IF(PX1(K).GT.PP1)L=L+INP(K)
IF(L-IAMP-1.LT.0)GO TO 2170
IAMP=L
AMPTIM=PP1
2170 IF(MX.EQ.3)GO TO 2612
C MX=3 IS FOR PROOF READING -- NOT ACTIVATED HERE!!!!
C ********* MAY 17,71
PP1=PP1-OP1
C PUTS SPACES BETWEEN NOTES .GT. .05( APART
IF(A.GE.PP1)GO TO 3170
WRITE(LPT,902)
A=PP1+.05
3170 X=INUM(J)
KL=0
NL=3
Y=1
IF(INVIS(J).EQ.0)GO TO 4170
X=P3
IF(INVIS(J).LT.0)GO TO 3021
NL=2
Y=4
L=IVAR
GO TO 7170
3021 Y=3.
L=IGEN
C Y=3 FOR 'GENS'. Y=4 FOR 'VARS'.
DO 5170 K=6,30
IF(P3.EQ.2.)GO TO 5170
IF(P(K).EQ.511.)NPA=K
5170 VZ(K)=0
7170 DO 6170 K=2,30
ML=K+2
VX(K)=VX(ML)
IF(ML.GT.NPA)GO TO 5902
Z=P(ML)
IF(PL(ML).EQ.2)CALL TMPSC
C RETURNS FREQ. IN HERTZ FOR 'Z'
GO TO 6170
C Z MUST BE FIXED ABOVE FOR RAN SELEC OF TMPRD SCALE.
5902 Z=0
6170 VZ(K)=Z
NPA=NPA-2
GO TO 8170
4170 IF(PL(3).EQ.2.)KL=P3+.0001
C .0001 FOR ROUND-OFF???? 4/73
DO 2021 K=3,30
IF(K.GT.NPA)GO TO 4902
Z=P(K)
IF(PL(K).EQ.2)CALL TMPSC
GO TO 2021
4902 Z=0
2021 VZ(K)=Z
IF(DF.GT.0)GO TO 6021
VX2=-DF
IF(VX2.GT.PP2)VX2=PP2
C NEG. DF=FIXED NOTE DUR. NOT.GT.PP2 7/74 COLGATE -AND BELOW
GO TO 7021
6021 IF(DF.LT.100)GO TO 8021
C DF>100 = FIXED REST AREA BEFORE NEXT ATTACK.
VX2=PP2-DF+100.
IF(VX2.LE.0)VX2=PP2/2.
C NO NEG. TIME VALUES ALLOWED.
GO TO 7021
8021 VZ2=PP2*DF
C DUTY FACTOR CONVERSION
7021 L=INST(J)
8170 IF(KL.GT.0)WRITE(LPT,2902)L,PP1,X,VZ2,VZ(3),
1 SCAL(KL),(VZ(K),K=4,11),J,L,ICT,BT
IF(KL.EQ.0.)WRITE(LPT,9902)L,PP1,X,(VZ(K),K=2,11),J,L,ICT,BT
C'NOTES' MAY BE USED IN P3-30 BUT LETTER NAME WILL ONLY PRINT FOR P3!
IF(NPA.GT.11)WRITE(LPT,3902)(VZ(K),K=12,23),J,L,ICT,BT
C VX(K) HOLDS CONVERSION FLAG.
VY(2)=VZ2
DO 1902 K=NL,NPA
Z=VZ(K)
IF(VX(K).EQ.1.)Z=CVTX/Z
IF(VX(K).EQ.-1.)Z=CVTX*Z
1902 VY(K)=Z
NPA=NPA+1
VY(NPA)=CVTX/VZ2
C LAST PARAM NOW CONVERTED AS NOTE DUR. PASS3 WILL READ NEXT.
IF(Y.NE.1.)NPA=NPA-1
L=NPA+2
WRITE(LPT,3612)L,Y,PP1,X,(VY(K),K=2,NPA)
WRITE (NWRITE)L,Y,PP1,X,(VY(K),K=2,NPA)
2612 PP1=ZPAR
GO TO 21
3612 FORMAT(I3,F3.0,F7.2,F3.0,F7.2,30F9.3)
2902 FORMAT(1XA4,1XF7.2,F3.0,F7.2,F8.2,'(',A3,')',8F8.2,'<',I2,1XA4,
1' <',I3,F7.2)
9902 FORMAT(1XA4,1XF7.2,F3.0,F9.2,3X9F8.2,'<'I2,1XA4,' <',I3,F7.2)
3902 FORMAT(3X12F8.2,'<'I2,1XA4,' <',I3,F7.2)
C PRINTS RESTS
2022 PP2=ABS(PP2)
C IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT PP2.
C FOR RESTS IN SEQS. TYPE -DUR.
C WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
C RAN RESTS ARE TOUCHED BY SUBROUTINES ONLY BY SETTING IREST!!
INP(J)=0
PX1(J)=PP1+PP2
IF(PP1.LT.OP1)GO TO 21
X=PP1-OP1
IF(A.GE.X)GO TO 121
WRITE(LPT,902)
A=X+.05
121 WRITE(LPT,104)INST(J),X,PP2,J,ICT
21 PR=ABS(PR)
BG(J)=BT+PR
IF(ICT.EQ.DUR(J)-10000.)GO TO 5174
IF(BG(J).LT.DUR(J))GO TO 500
5174 BG(J)=19999.
DO 3174 K=1,NINS
C INSRTS CANT FOLLOW LST REG NOTE.(ADD RST IF INSRT AT END NEEDED.)
3174 IF(BG(K).LT.19999.)GO TO 500
GO TO 175
C CHOOSES INST WITH NEXT BEGIN TIME.
500 J=1
BW=BT
IF(NINS.EQ.1)GO TO 3022
5022 IF(BG(J).NE.19999.)GO TO 4022
J=J+1
GO TO 5022
4022 DO 22 K=2,NINS
22 IF(PX1(J).GT.PX1(K).AND.BG(K).NE.19999.)J=K
3022 BT=BG(J)
IF(BT.EQ.19999..OR.PX1(J).GE.DURX)GO TO 175
IF(CNT(J).GT.0)GO TO 1022
IF(CNT(J).EQ.0)PX1(J)=0
IF(CNT(J).EQ.-1)CNT(J)=0
C N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0
1022 IF(BT.LT.T6.OR.IT3.GT.1)GO TO 1108
T4=T2
T5=0
T6=10000.
GO TO 1108
175 Y=0
DO 105 K=1,NINS
X=PX1(K)-OP1
105 IF(Y.LT.X)Y=X
Y=Y+.5
C ADDS .5" OF SILENCE.
WRITE(LPT,7902) Y
L=2
Z=6.
WRITE(LPT,3612)L,Z,Y
WRITE(NWRITE)L,Z,Y
7902 FORMAT(' TER',F10.3,';'/)
603 FORMAT(I3,' INSTS. DURATIONS=',10F8.2)
TYPE 1603,AMPFAC,IAMP,AMPTIM
WRITE(LPT,1603)AMPFAC,IAMP,AMPTIM
DO 2175 K=1,NINS
2175 P(K)=PX1(K)-OP1
WRITE(LPT,603)NINS,(P(K),K=1,NINS)
TYPE 603,NINS,(P(K),K=1,NINS)
CALL EXIT
104 FORMAT(' ***** ',A4,2F8.2,7X,'REST <',I2,I4)
1603 FORMAT(' AMPL. FACTOR=',F4.2,', P4 MAX.AMP.=',I4,', AT TIME',
1 F8.3)
END
C***** THIS ROUTINE DIVIDES OCTAVE INTO ANY NUMBER OF EQUAL PARTS
SUBROUTINE SUBR
COMMON/X/P(30),INST,IPAR,CNT(25),BT,IREST,CVT(35),
1 PL(30),DF,DUR(25)
C CALL SUBROUTINE FROM P12. P3 CAN BE NOTES OR NUMBS.
X=P(3)
IF(PL(3).EQ.1)GO TO 1
IF(P(12).EQ.0)X=IFIX(X)
C FOR RAND NOTES TO PRINT OUT FREQS.
X=30.868*2**(X/12)
C X=FREQ. IN HZ. BASED ON NOTE # IN P3.
PL(3)=1.
C THIS CAUSES FREQ. NUM TO PRINT INSTEAD OF LITERAL CHARACTERS.
1 P(3)=X*2**(P(11)/P(12))
C P12=# OF DIVISIONS OF THE OCTAVE. P11=CHROMATIC STEP IN THAT DIV.
RETURN
END
C STEPS ; TYPICAL INPUT FOR MICROTONE SUBROUTINE.
C CLAR /P2 .3/P3 A3/P4 1000;
C P11 NUM/0/1/2/3/4/5/6/7/8/9/FINE*;
C P12 9 SUBR/END; OCTAVE IS DIVIDED INTO 9 PARTS.